home *** CD-ROM | disk | FTP | other *** search
/ Night Owl 6 / Night Owl's Shareware - PDSI-006 - Night Owl Corp (1990).iso / 039a / mawk.zip / BI_FUNCT.C < prev    next >
C/C++ Source or Header  |  1991-04-17  |  18KB  |  782 lines
  1.  
  2. /********************************************
  3. bi_funct.c
  4. copyright 1991, Michael D. Brennan
  5.  
  6. This is a source file for mawk, an implementation of
  7. the Awk programming language as defined in
  8. Aho, Kernighan and Weinberger, The AWK Programming Language,
  9. Addison-Wesley, 1988.
  10.  
  11. See the accompaning file, LIMITATIONS, for restrictions
  12. regarding modification and redistribution of this
  13. program in source or binary form.
  14. ********************************************/
  15.  
  16.  
  17. /* $Log:    bi_funct.c,v $
  18.  * Revision 2.3  91/04/17  06:34:00  brennan
  19.  * index("","") should be 1 not 0 for consistency with match("",//)
  20.  * 
  21.  * Revision 2.2  91/04/09  12:38:42  brennan
  22.  * added static to funct decls to satisfy STARDENT compiler
  23.  * 
  24.  * Revision 2.1  91/04/08  08:22:17  brennan
  25.  * VERSION 0.97
  26.  * 
  27. */
  28.  
  29.  
  30. #include "mawk.h"
  31. #include "bi_funct.h"
  32. #include "bi_vars.h"
  33. #include "memory.h"
  34. #include "init.h"
  35. #include "files.h"
  36. #include "fin.h"
  37. #include "field.h"
  38. #include "regexp.h"
  39. #include "repl.h"
  40. #include <math.h>
  41.  
  42. #ifndef  BSD43
  43. void PROTO( srand48, (long) ) ;
  44. double PROTO( drand48, (void) ) ;
  45. #endif
  46.  
  47. /* statics */
  48. static STRING *PROTO(gsub, (PTR, CELL *, char *, int) ) ;
  49. static void  PROTO( fplib_err, (char *, double, char *) ) ;
  50.  
  51.  
  52. /* global for the disassembler */
  53. BI_REC  bi_funct[] = { /* info to load builtins */
  54.  
  55. "index" , bi_index , 2, 2 ,
  56. "substr" , bi_substr, 2, 3,
  57. "sprintf" , bi_sprintf, 1, 255,
  58. "sin", bi_sin , 1, 1 ,
  59. "cos", bi_cos , 1, 1 ,
  60. "atan2", bi_atan2, 2,2,
  61. "exp", bi_exp, 1, 1,
  62. "log", bi_log , 1, 1 ,
  63. "int", bi_int, 1, 1,
  64. "sqrt", bi_sqrt, 1, 1,
  65. "rand" , bi_rand, 0, 0,
  66. "srand", bi_srand, 0, 1,
  67. "close", bi_close, 1, 1,
  68. "system", bi_system, 1, 1,
  69.  
  70. #if  DOS   /* this might go away, when pipes and system are added
  71.           for DOS  */
  72. "errmsg", bi_errmsg, 1, 1,
  73. #endif
  74.  
  75. (char *) 0, (PF_CP) 0, 0, 0 } ;
  76.  
  77.  
  78.  
  79. void bi_funct_init()
  80. { register BI_REC *p = bi_funct ;
  81.   register SYMTAB *stp ;
  82.  
  83.   while ( p->name )
  84.   { stp = insert( p->name ) ;
  85.     stp->type = ST_BUILTIN ;
  86.     stp->stval.bip = p++ ;
  87.   }
  88.   /* seed rand() off the clock */
  89.   { CELL c ;
  90.  
  91.     c.type = 0 ; (void) bi_srand(&c) ;
  92.   }
  93.  
  94.   stp = insert( "length") ;
  95.   stp->type = ST_LENGTH ;
  96. }
  97.  
  98. /**************************************************
  99.  string builtins (except split (in split.c) and [g]sub (at end))
  100.  **************************************************/
  101.  
  102. CELL *bi_length(sp)
  103.   register  CELL *sp ;
  104. { unsigned len ;
  105.  
  106.   if ( sp->type < C_STRING ) cast1_to_s(sp) ;
  107.   len = string(sp)->len ;
  108.  
  109.   free_STRING( string(sp) ) ;
  110.   sp->type = C_DOUBLE ;
  111.   sp->dval = (double) len ;
  112.  
  113.   return sp ;
  114. }
  115.  
  116. char *str_str(target, key , key_len)
  117.   register char *target, *key ;
  118.   unsigned key_len ;
  119. { 
  120.   switch( key_len )
  121.   { case 0 :  return (char *) 0 ;
  122.     case 1 :  return strchr( target, *key) ;
  123.     case 2 :
  124.         while ( target = strchr(target, *key) )
  125.           if ( target[1] == key[1] )  return  target ;
  126.           else target++ ;
  127.         /*failed*/
  128.         return (char *) 0 ;
  129.   }
  130.   key_len-- ;
  131.   while ( target = strchr(target, *key) )
  132.         if ( memcmp(target+1, key+1, key_len) == 0 ) return target ;
  133.         else target++ ;
  134.   /*failed*/
  135.   return (char *) 0 ;
  136. }
  137.  
  138.  
  139.  
  140. CELL *bi_index(sp)
  141.   register CELL *sp ;
  142. { register int idx ;
  143.   unsigned len ;
  144.   char *p ;
  145.  
  146.   sp-- ;
  147.   if ( TEST2(sp) != TWO_STRINGS )
  148.         cast2_to_s(sp) ;
  149.  
  150.   if ( len = string(sp+1)->len )
  151.     idx = (p = str_str(string(sp)->str,string(sp+1)->str,len))
  152.           ? p - string(sp)->str + 1 : 0 ;
  153.  
  154.   else  /* index of the empty string */
  155.     idx = 1 ;
  156.   
  157.   free_STRING( string(sp) ) ;
  158.   free_STRING( string(sp+1) ) ;
  159.   sp->type = C_DOUBLE ;
  160.   sp->dval = (double) idx ;
  161.   return sp ;
  162. }
  163.  
  164. /*  substr(s, i, n)
  165.     if l = length(s)
  166.     then get the characters
  167.     from  max(1,i) to min(l,n-i-1) inclusive */
  168.  
  169. CELL *bi_substr(sp)
  170.   CELL *sp ;
  171. { int n_args, len ;
  172.   register int i, n ;
  173.   char *s ;    /* substr(s, i, n) */
  174.   STRING *sval ;
  175.  
  176.   n_args = sp->type ;
  177.   sp -= n_args ;
  178.   if ( sp->type < C_STRING )  cast1_to_s(sp) ;
  179.   s = (sval = string(sp)) -> str ;
  180.  
  181.   if ( n_args == 2 )  
  182.   { n = 0x7fff  ;  /* essentially infinity */
  183.     if ( sp[1].type != C_DOUBLE ) cast1_to_d(sp+1) ; 
  184.   }
  185.   else
  186.   { if ( sp[1].type + sp[2].type != TWO_STRINGS ) cast2_to_d(sp+1) ;
  187.     n = (int) sp[2].dval ;
  188.   }
  189.   i = (int) sp[1].dval - 1 ; /* i now indexes into string */
  190.  
  191.  
  192.   if ( (len = strlen(s)) == 0 )  return sp ;
  193.   /* get to here is s is not the null string */
  194.   if ( i < 0 ) { n += i ; i = 0 ; }
  195.   if ( n > len - i )  n = len - i ;
  196.  
  197.   if ( n <= 0 )  /* the null string */
  198.   { free_STRING( sval ) ;
  199.     sp->ptr = (PTR) &null_str ;
  200.     null_str.ref_cnt++ ;
  201.   }
  202.   else  /* got something */
  203.   { 
  204.     sp->ptr = (PTR) new_STRING((char *)0, n) ;
  205.     (void) memcpy(string(sp)->str, s+i, n) ;
  206.     string(sp)->str[n] = 0 ;
  207.   }
  208.   return sp ;
  209. } 
  210.  
  211. /*
  212.   match(s,r)
  213.   sp[0] holds s, sp[-1] holds r
  214. */
  215.  
  216. CELL *bi_match(sp)
  217.   register CELL *sp ;
  218. { double d ;
  219.   char *p ;
  220.   unsigned length ;
  221.  
  222.   if ( sp->type != C_RE )  cast_to_RE(sp) ;
  223.   if ( (--sp)->type < C_STRING )  cast1_to_s(sp) ;
  224.  
  225.   if ( p = REmatch(string(sp)->str, (sp+1)->ptr, &length) )
  226.       d = (double) ( p - string(sp)->str + 1 ) ;
  227.   else  d = 0.0 ;
  228.  
  229.   cell_destroy( & bi_vars[RSTART] ) ;
  230.   cell_destroy( & bi_vars[RLENGTH] ) ;
  231.   bi_vars[RSTART].type = C_DOUBLE ;
  232.   bi_vars[RSTART].dval = d ;
  233.   bi_vars[RLENGTH].type = C_DOUBLE ;
  234.   bi_vars[RLENGTH].dval = (double) length ;
  235.  
  236.   free_STRING(string(sp)) ;
  237.     
  238.   sp->type = C_DOUBLE ;  sp->dval = d ;
  239.   return sp ;
  240. }
  241.  
  242.  
  243. /************************************************
  244.   arithemetic builtins
  245.  ************************************************/
  246.  
  247. static void fplib_err( fname, val, error)
  248.   char *fname ;
  249.   double val ;
  250.   char *error ;
  251. {
  252.   rt_error("%s(%g) : %s" , fname, val, error) ;
  253. }
  254.  
  255.  
  256. CELL *bi_sin(sp)
  257.   register CELL *sp ;
  258. { 
  259. #if ! STDC_MATHERR
  260.   if ( sp->type != C_DOUBLE )  cast1_to_d(sp) ;
  261.   sp->dval = sin( sp->dval ) ;
  262.   return sp ;
  263. #else
  264.   double x ;
  265.  
  266.   errno = 0 ;
  267.   if ( sp->type != C_DOUBLE )  cast1_to_d(sp) ;
  268.   x = sp->dval ;
  269.   sp->dval = sin( sp->dval ) ;
  270.   if ( errno )  fplib_err("sin", x, "loss of precision") ;
  271.   return sp ;
  272. #endif
  273. }
  274.  
  275. CELL *bi_cos(sp)
  276.   register CELL *sp ;
  277. { 
  278. #if ! STDC_MATHERR
  279.   if ( sp->type != C_DOUBLE )  cast1_to_d(sp) ;
  280.   sp->dval = cos( sp->dval ) ;
  281.   return sp ;
  282. #else
  283.   double x ;
  284.  
  285.   errno = 0 ;
  286.   if ( sp->type != C_DOUBLE )  cast1_to_d(sp) ;
  287.   x = sp->dval ;
  288.   sp->dval = cos( sp->dval ) ;
  289.   if ( errno )  fplib_err("cos", x, "loss of precision") ;
  290.   return sp ;
  291. #endif
  292. }
  293.  
  294. CELL *bi_atan2(sp)
  295.   register CELL *sp ;
  296. { 
  297. #if  !  STDC_MATHERR
  298.   sp-- ;
  299.   if ( TEST2(sp) != TWO_DOUBLES ) cast2_to_d(sp) ;
  300.   sp->dval = atan2(sp->dval, (sp+1)->dval) ;
  301.   return sp ;
  302. #else
  303.  
  304.   errno = 0 ;
  305.   sp-- ;
  306.   if ( TEST2(sp) != TWO_DOUBLES ) cast2_to_d(sp) ;
  307.   sp->dval = atan2(sp->dval, (sp+1)->dval) ;
  308.   if ( errno ) rt_error("atan2(0,0) : domain error") ;
  309.   return sp ;
  310. #endif
  311. }
  312.  
  313. CELL *bi_log(sp)
  314.   register CELL *sp ;
  315. { 
  316. #if ! STDC_MATHERR
  317.   if ( sp->type != C_DOUBLE )  cast1_to_d(sp) ;
  318.   sp->dval = log( sp->dval ) ;
  319.   return sp ;
  320. #else
  321.   double  x ;
  322.  
  323.   errno = 0 ;
  324.   if ( sp->type != C_DOUBLE )  cast1_to_d(sp) ;
  325.   x = sp->dval ;
  326.   sp->dval = log( sp->dval ) ;
  327.   if ( errno )  fplib_err("log", x, "domain error") ;
  328.   return sp ;
  329. #endif
  330. }
  331.  
  332. CELL *bi_exp(sp)
  333.   register CELL *sp ;
  334. { 
  335. #if  ! STDC_MATHERR
  336.   if ( sp->type != C_DOUBLE )  cast1_to_d(sp) ;
  337.   sp->dval = exp(sp->dval) ;
  338.   return sp ;
  339. #else
  340.   double  x ;
  341.  
  342.   errno = 0 ;
  343.   if ( sp->type != C_DOUBLE )  cast1_to_d(sp) ;
  344.   x = sp->dval ;
  345.   sp->dval = exp(sp->dval) ;
  346.   if ( errno && sp->dval)  fplib_err("exp", x, "overflow") ;
  347.      /* on underflow sp->dval==0, ignore */
  348.   return sp ;
  349. #endif
  350. }
  351.  
  352. CELL *bi_int(sp)
  353.   register CELL *sp ;
  354. { if ( sp->type != C_DOUBLE )  cast1_to_d(sp) ;
  355.   sp->dval = sp->dval >= 0.0 ? floor( sp->dval ) : ceil(sp->dval)  ;
  356.   return sp ;
  357. }
  358.  
  359. CELL *bi_sqrt(sp)
  360.   register CELL *sp ;
  361. { 
  362. #if  ! STDC_MATHERR
  363.   if ( sp->type != C_DOUBLE )  cast1_to_d(sp) ;
  364.   sp->dval = sqrt( sp->dval ) ;
  365.   return sp ;
  366. #else
  367.   double x ;
  368.  
  369.   errno = 0 ;
  370.   if ( sp->type != C_DOUBLE )  cast1_to_d(sp) ;
  371.   x = sp->dval ;
  372.   sp->dval = sqrt( sp->dval ) ;
  373.   if ( errno )  fplib_err("sqrt", x, "domain error") ;
  374.   return sp ;
  375. #endif
  376. }
  377.  
  378. #ifdef  __TURBOC__
  379. long  biostime(int, long) ;
  380. #define  time(x)  (biostime(0,0L)<<4)
  381. #else
  382. #include <sys/types.h>
  383.  
  384. #if 0
  385. #ifndef  STARDENT
  386. #include <sys/timeb.h>
  387. #endif
  388. #endif
  389.  
  390. #endif
  391.  
  392. CELL *bi_srand(sp)
  393.   register CELL *sp ;
  394. { register long l ; 
  395.   void srand48() ;
  396.  
  397.   if ( sp-- -> type )  /* user seed */
  398.   { if ( sp->type != C_DOUBLE )  cast1_to_d(sp) ;
  399.     l = (long) sp->dval ; }
  400.   else
  401.   { l = (long) time( (time_t *) 0 ) ;
  402.     (++sp)->type = C_DOUBLE ;
  403.     sp->dval = (double) l ;
  404.   }
  405.   srand48(l) ;
  406.   return sp ;
  407. }
  408.     
  409. CELL *bi_rand(sp)
  410.   register CELL *sp ;
  411. { 
  412.  
  413.   (++sp)->type = C_DOUBLE ;
  414.   sp->dval = drand48() ;
  415.   return sp ;
  416. }
  417.  
  418. /*************************************************
  419.  miscellaneous builtins
  420.  close, system and getline
  421.  *************************************************/
  422.  
  423. CELL *bi_close(sp)
  424.   register CELL *sp ;
  425. { int x ;
  426.  
  427.   if ( sp->type < C_STRING ) cast1_to_s(sp) ;
  428.   x = file_close( (STRING *) sp->ptr) ;
  429.   free_STRING( string(sp) ) ;
  430.   sp->type = C_DOUBLE ;
  431.   sp->dval = (double) x ;
  432.   return sp ;
  433. }
  434.  
  435. #if   ! DOS
  436. CELL *bi_system(sp)
  437.   CELL *sp ;
  438. { int pid ;
  439.   unsigned ret_val ;
  440.  
  441.   if ( !shell ) shell = (shell = getenv("SHELL")) ? shell : "/bin/sh" ;
  442.   if ( sp->type < C_STRING ) cast1_to_s(sp) ;
  443.  
  444.   switch( pid = fork() )
  445.   { case -1 :  /* fork failed */
  446.  
  447.        errmsg(errno, "could not create a new process") ;
  448.        ret_val = 128 ;
  449.        break ;
  450.  
  451.     case  0  :  /* the child */
  452.        (void) execl(shell, shell, "-c", string(sp)->str, (char *) 0) ;
  453.        /* if get here, execl() failed */
  454.        errmsg(errno, "execute of %s failed", shell) ;
  455.        fflush(stderr) ;
  456.        _exit(128) ;
  457.  
  458.     default   :  /* wait for the child */
  459.        ret_val = wait_for(pid) ;
  460.        if ( ret_val & 0xff ) ret_val = 128 ;
  461.        else  ret_val = (ret_val & 0xff00) >> 8 ;
  462.        break ;
  463.   }
  464.  
  465.   cell_destroy(sp) ;
  466.   sp->type = C_DOUBLE ;
  467.   sp->dval = (double) ret_val ;
  468.   return sp ;
  469. }
  470.  
  471. #else   /*  DOS   */
  472.  
  473. CELL *bi_system( sp )
  474.   register CELL *sp ;
  475. { rt_error("no system call in MsDos --yet") ;
  476.   return sp ;
  477. }
  478.  
  479. /* prints errmsgs for DOS  */
  480. CELL *bi_errmsg(sp)
  481.   register CELL *sp ;
  482. {
  483.   cast1_to_s(sp) ;
  484.   fprintf(stderr, "%s\n", string(sp)->str) ;
  485.   free_STRING(string(sp)) ;
  486.   sp->type = C_DOUBLE ;
  487.   sp->dval = 0.0 ;
  488.   return sp ;
  489. }
  490. #endif
  491.  
  492.  
  493. /*  getline()  */
  494.  
  495. /*  if type == 0 :  stack is 0 , target address
  496.  
  497.     if type == F_IN : stack is F_IN, expr(filename), target address
  498.  
  499.     if type == PIPE_IN : stack is PIPE_IN, target address, expr(pipename)
  500. */
  501.  
  502. CELL *bi_getline(sp)
  503.   register CELL *sp ;
  504. { 
  505.   CELL tc , *cp ;
  506.   char *p ;
  507.   unsigned len ;
  508.   FIN *fin_p ;
  509.  
  510.  
  511.   switch( sp->type )
  512.   { 
  513.     case 0 :
  514.         sp-- ;
  515.         if ( main_fin == (FIN *) -1 && ! open_main() )
  516.                 goto open_failure ;
  517.     
  518.         if ( ! main_fin || !(p = FINgets(main_fin, &len)) )
  519.                 goto  eof ;
  520.  
  521.         cp = (CELL *) sp->ptr ;
  522.         if ( TEST2(bi_vars+NR) != TWO_DOUBLES ) cast2_to_d(bi_vars+NR) ;
  523.         bi_vars[NR].dval += 1.0 ;
  524.         bi_vars[FNR].dval += 1.0 ;
  525.         break ;
  526.  
  527.     case  F_IN :
  528.         sp-- ;
  529.         if ( sp->type < C_STRING ) cast1_to_s(sp) ;
  530.         fin_p = (FIN *) file_find(sp->ptr, F_IN) ;
  531.         free_STRING(string(sp) ) ;
  532.         sp-- ;
  533.  
  534.         if ( ! fin_p )   goto open_failure ;
  535.         if ( ! (p = FINgets(fin_p, &len)) )  goto eof ; 
  536.         cp = (CELL *) sp->ptr ;
  537.         break ;
  538.  
  539.     case PIPE_IN :
  540.         sp -= 2 ;
  541.         if ( sp->type < C_STRING ) cast1_to_s(sp) ;
  542.         fin_p = (FIN *) file_find(sp->ptr, PIPE_IN) ;
  543.         free_STRING(string(sp)) ;
  544.  
  545.         if ( ! fin_p )   goto open_failure ;
  546.         if ( ! (p = FINgets(fin_p, &len)) )  goto eof ; 
  547.         cp = (CELL *) (sp+1)->ptr ;
  548.         break ;
  549.  
  550.     default : bozo("type in bi_getline") ;
  551.  
  552.   }
  553.  
  554.   /* we've read a line , store it */
  555.  
  556.     if ( len == 0 )
  557.     { tc.type = C_STRING ; 
  558.       tc.ptr = (PTR) &null_str ; 
  559.       null_str.ref_cnt++ ;
  560.     }
  561.     else
  562.     { tc.type = C_MBSTRN ;
  563.       tc.ptr = (PTR) new_STRING((char *) 0, len) ;
  564.       (void) memcpy( string(&tc)->str, p, len) ;
  565.     }
  566.  
  567.     if ( cp  >= field && cp < field+NUM_FIELDS )
  568.            field_assign(cp-field, &tc) ;
  569.     else
  570.     { cell_destroy(cp) ;
  571.       (void) cellcpy(cp, &tc) ;
  572.     }
  573.  
  574.     cell_destroy(&tc) ;
  575.  
  576.   sp->dval = 1.0  ;  goto done ;
  577.  
  578. open_failure :
  579.   sp->dval = -1.0  ; goto done ;
  580.  
  581. eof :
  582.   sp->dval = 0.0  ;  /* fall thru to done  */
  583.  
  584. done :
  585.   sp->type = C_DOUBLE  ;
  586.   return sp ;
  587. }
  588.  
  589. /**********************************************
  590.  sub() and gsub()
  591.  **********************************************/
  592.  
  593. /* entry:  sp[0] = address of CELL to sub on
  594.            sp[-1] = substitution CELL
  595.            sp[-2] = regular expression to match
  596. */
  597.  
  598. CELL *bi_sub( sp )
  599.   register CELL *sp ;
  600. { CELL *cp ; /* pointer to the replacement target */
  601.   CELL tc ;  /* build the new string here */
  602.   CELL sc ;  /* copy of the target CELL */
  603.   char *front, *middle, *back ; /* pieces */
  604.   unsigned front_len, middle_len, back_len ;
  605.  
  606.   sp -= 2 ;
  607.   if ( sp->type != C_RE )  cast_to_RE(sp) ;
  608.   if ( sp[1].type != C_REPL && sp[1].type != C_REPLV )
  609.               cast_to_REPL(sp+1) ;
  610.   cp = (CELL *) (sp+2)->ptr ;
  611.   /* make a copy of the target, because we won't change anything
  612.      including type unless the match works */
  613.   (void) cellcpy(&sc, cp) ;
  614.   if ( sc.type < C_STRING ) cast1_to_s(&sc) ;
  615.   front = string(&sc)->str ;
  616.  
  617.   if ( middle = REmatch(front, sp->ptr, &middle_len) )
  618.   { 
  619.     front_len = middle - front ;
  620.     back = middle + middle_len ; 
  621.     back_len = string(&sc)->len - front_len - middle_len ;
  622.  
  623.     if ( (sp+1)->type == C_REPLV ) 
  624.     { STRING *sval = new_STRING((char *) 0, middle_len) ;
  625.  
  626.       (void) memcpy(sval->str, middle, middle_len) ;
  627.       (void) replv_to_repl(sp+1, sval) ;
  628.       free_STRING(sval) ;
  629.     }
  630.  
  631.     tc.type = C_STRING ;
  632.     tc.ptr = (PTR) new_STRING((char *) 0, 
  633.              front_len + string(sp+1)->len + back_len ) ;
  634.  
  635.     { char *p = string(&tc)->str ;
  636.  
  637.       if ( front_len )
  638.       { (void) memcpy(p, front, front_len) ;
  639.         p += front_len ;
  640.       }
  641.       if ( string(sp+1)->len )
  642.       { (void) memcpy(p, string(sp+1)->str, string(sp+1)->len) ;
  643.         p += string(sp+1)->len ;
  644.       }
  645.       if ( back_len )  (void) memcpy(p, back, back_len) ;
  646.     }
  647.  
  648.     if ( cp  >= field && cp < field+NUM_FIELDS )
  649.            field_assign(cp-field, &tc) ;
  650.     else
  651.     { cell_destroy(cp) ;
  652.       (void) cellcpy(cp, &tc) ;
  653.     }
  654.  
  655.     free_STRING(string(&tc)) ;
  656.   }
  657.  
  658.   free_STRING(string(&sc)) ;
  659.   repl_destroy(sp+1) ;
  660.   sp->type = C_DOUBLE ;
  661.   sp->dval = middle != (char *) 0 ? 1.0 : 0.0 ;
  662.   return sp ;
  663. }
  664.  
  665. static  unsigned repl_cnt ;  /* number of global replacements */
  666.  
  667. /* recursive global subsitution 
  668.    dealing with empty matches makes this mildly painful
  669. */
  670.  
  671. static STRING *gsub( re, repl, target, flag)
  672.   PTR  re ;
  673.   CELL *repl ;  /* always of type REPL or REPLV */
  674.   char *target ;
  675.   int flag ; /* if on, match of empty string at front is OK */
  676. { char *front, *middle ;
  677.   STRING *back ;
  678.   unsigned front_len, middle_len ;
  679.   STRING  *ret_val ;
  680.   CELL xrepl ; /* a copy of repl so we can change repl */
  681.  
  682.   if ( ! (middle = REmatch(target, re, &middle_len)) )
  683.       return  new_STRING(target) ; /* no match */
  684.  
  685.   (void) cellcpy(&xrepl, repl) ;
  686.  
  687.   if ( !flag && middle_len == 0 && middle == target ) 
  688.   { /* match at front that's not allowed */
  689.  
  690.     if ( *target == 0 )  /* target is empty string */
  691.     { null_str.ref_cnt++ ;
  692.       return & null_str ;
  693.     }
  694.     else
  695.     { char xbuff[2] ;
  696.  
  697.       front_len = 0 ;
  698.       /* make new repl with target[0] */
  699.       repl_destroy(repl) ;
  700.       xbuff[0] = *target++ ;  xbuff[1] = 0 ;
  701.       repl->type = C_REPL ;
  702.       repl->ptr = (PTR) new_STRING( xbuff ) ;
  703.       back = gsub(re, &xrepl, target, 1) ;
  704.     }
  705.   }
  706.   else  /* a match that counts */
  707.   { repl_cnt++ ;
  708.  
  709.     front = target ;
  710.     front_len = middle - target ;
  711.  
  712.     if ( *middle == 0 )  /* matched back of target */
  713.     { back = &null_str ; null_str.ref_cnt++ ; }
  714.     else back = gsub(re, &xrepl, middle + middle_len, 0) ;
  715.       
  716.     /* patch the &'s if needed */
  717.     if ( repl->type == C_REPLV )
  718.     { STRING *sval = new_STRING((char *) 0, middle_len) ;
  719.  
  720.       (void) memcpy(sval->str, middle, middle_len) ;
  721.       (void) replv_to_repl(repl, sval) ;
  722.       free_STRING(sval) ;
  723.     }
  724.   }
  725.  
  726.   /* put the three pieces together */
  727.   ret_val = new_STRING((char *)0,
  728.               front_len + string(repl)->len + back->len); 
  729.   { char *p = ret_val->str ;
  730.  
  731.     if ( front_len )
  732.     { (void) memcpy(p, front, front_len) ; p += front_len ; }
  733.     if ( string(repl)->len )
  734.     { (void) memcpy(p, string(repl)->str, string(repl)->len) ;
  735.       p += string(repl)->len ;
  736.     }
  737.     if ( back->len ) (void) memcpy(p, back->str, back->len) ;
  738.   }
  739.  
  740.   /* cleanup, repl is freed by the caller */
  741.   repl_destroy(&xrepl) ;
  742.   free_STRING(back) ;
  743.  
  744.   return ret_val ;
  745. }
  746.  
  747. /* set up for call to gsub() */
  748. CELL *bi_gsub( sp )
  749.   register CELL *sp ;
  750. { CELL *cp ;  /* pts at the replacement target */
  751.   CELL sc  ;  /* copy of replacement target */
  752.   CELL tc  ;  /* build the result here */
  753.  
  754.   sp -= 2 ;
  755.   if ( sp->type != C_RE ) cast_to_RE(sp) ;
  756.   if ( (sp+1)->type != C_REPL && (sp+1)->type != C_REPLV )
  757.           cast_to_REPL(sp+1) ;
  758.  
  759.   (void) cellcpy(&sc, cp = (CELL *)(sp+2)->ptr) ;
  760.   if ( sc.type < C_STRING ) cast1_to_s(&sc) ;
  761.  
  762.   repl_cnt = 0 ;
  763.   tc.ptr = (PTR) gsub(sp->ptr, sp+1, string(&sc)->str, 1) ;
  764.  
  765.   if ( repl_cnt )
  766.   { tc.type = C_STRING ;
  767.  
  768.     if ( cp >= field && cp < field + NUM_FIELDS )
  769.         field_assign(cp-field, &tc) ;
  770.     else
  771.     { cell_destroy(cp) ; (void) cellcpy(cp, &tc) ; }
  772.   }
  773.  
  774.   /* cleanup */
  775.   free_STRING(string(&sc)) ; free_STRING(string(&tc)) ;
  776.   repl_destroy(sp+1) ;
  777.  
  778.   sp->type = C_DOUBLE ;
  779.   sp->dval = (double) repl_cnt ;
  780.   return sp ;
  781. }
  782.